home *** CD-ROM | disk | FTP | other *** search
- (*----------------------------------------------------------------------*)
- (* Ansi_Set_Graphics --- Set graphics display *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Ansi_Set_Graphics;
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Ansi_Set_Graphics *)
- (* *)
- (* Purpose: Sets graphics rendition modes for ANSI/VT100 *)
- (* *)
- (* Calling Sequence: *)
- (* *)
- (* Ansi_Set_Graphics; *)
- (* *)
- (* Calls: *)
- (* *)
- (* TextColor *)
- (* TextBackGround *)
- (* *)
- (* Called by: VT100_Process_Escape *)
- (* Ansi_Process_Escape *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- I : INTEGER;
- J : INTEGER;
-
- BEGIN (* Ansi_Set_Graphics *)
-
- FG := Ansi_Foreground_Color;
- BG := Ansi_Background_Color;
-
- IF ( Escape_Number = 0 ) THEN
- BEGIN
- Escape_Number := 1;
- Escape_Register[1] := 0;
- END;
-
- FOR I := 1 TO Escape_Number DO
- BEGIN
-
- CASE Escape_Register[I] OF
-
- 0 : BEGIN
- White_Shade := Ansi_ForeGround_Color;
- FG := White_Shade;
- BG := Ansi_BackGround_Color;
- END;
-
- 1 : BEGIN
- White_Shade := Ansi_Bold_Color;
- FG := White_Shade;
- END;
-
- 4 : BEGIN
- (* NOTE: In mono mode BLUE will *)
- (* correctly produce an underline. *)
-
- FG := Ansi_Underline_Color;
-
- END;
-
- 5 : FG := FG + Blink;
-
- 7 : BEGIN
- FG := Ansi_BackGround_Color;
- BG := Ansi_ForeGround_Color;
- END;
-
- 8 : FG := BG;
-
- 30 : FG := BLACK;
-
- 31 : IF ( Text_Mode = C80 ) THEN FG := RED;
-
- 32 : IF ( Text_Mode = C80 ) THEN FG := GREEN;
-
- 33 : IF ( Text_Mode = C80 ) THEN FG := YELLOW;
-
- 34 : IF ( Text_Mode = C80 ) THEN FG := BLUE;
-
- 35 : IF ( Text_Mode = C80 ) THEN FG := MAGENTA;
-
- 36 : IF ( Text_Mode = C80 ) THEN FG := CYAN;
-
- 37 : IF ( Text_Mode = C80 ) THEN FG := White_Shade;
-
- 40 : BG := BLACK;
-
- 41 : IF ( Text_Mode = C80 ) THEN BG := RED;
-
- 42 : IF ( Text_Mode = C80 ) THEN BG := GREEN;
-
- 43 : IF ( Text_Mode = C80 ) THEN BG := YELLOW;
-
- 44 : IF ( Text_Mode = C80 ) THEN BG := BLUE;
-
- 45 : IF ( Text_Mode = C80 ) THEN BG := MAGENTA;
-
- 46 : IF ( Text_Mode = C80 ) THEN BG := CYAN;
-
- 47 : BG := White_Shade;
-
- END (* CASE *);
-
- END;
- (* Change the colors *)
- TextColor ( FG );
- TextBackGround( BG );
-
- END (* Ansi_Set_Graphics *);
-
- (*----------------------------------------------------------------------*)
- (* Ansi_Set_Cursor --- Set cursor position *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Ansi_Set_Cursor;
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Ansi_Set_Cursor *)
- (* *)
- (* Purpose: Sets cursor position *)
- (* *)
- (* Calling Sequence: *)
- (* *)
- (* Ansi_Set_Cursor; *)
- (* *)
- (* Calls: *)
- (* *)
- (* Max *)
- (* Min *)
- (* UpperLeft *)
- (* *)
- (* Called by: VT100_Process_Escape *)
- (* Ansi_Process_Escape *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- Row: INTEGER;
- Col: INTEGER;
-
- BEGIN (* Ansi_Set_Cursor *)
-
- CASE Escape_Number OF
- (* Home cursor if no coords given *)
- 0 : BEGIN
- Row := 1;
- Col := 1;
- END;
- (* Column 1 is default, row provided *)
- 1 : BEGIN
- Col := 1;
- Row := Escape_Register[1];
- END;
- (* Both row and column provided *)
- ELSE
- Col := Escape_Register[2];
- Row := Escape_Register[1];
-
- END;
-
- Row := MAX( MIN( Row , 25 ) , 1 );
- Col := MAX( MIN( Col , 80 ) , 1 );
-
- (* Move to new coordinates *)
- GoToXY( Col , Row );
-
- END (* Ansi_Set_Cursor *);
-
- (*----------------------------------------------------------------------*)
- (* Ansi_Clear_Screen --- Clear segment of screen *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Ansi_Clear_Screen;
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Ansi_Clear_Screen *)
- (* *)
- (* Purpose: Clears portion of screen *)
- (* *)
- (* Calling Sequence: *)
- (* *)
- (* Ansi_Clear_Screen; *)
- (* *)
- (* Called by: VT100_Process_Escape *)
- (* Ansi_Process_Escape *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- I: INTEGER;
- X: INTEGER;
- Y: INTEGER;
- C: INTEGER;
- Save_FG1: INTEGER;
- Save_BG1: INTEGER;
-
- BEGIN (* Ansi_Clear_Screen *)
-
- IF ( Escape_Number = 1 ) THEN
- C := Escape_Register[1]
- ELSE
- C := 0;
-
- Save_FG1 := FG;
- Save_BG1 := BG;
-
- TextColor ( Ansi_ForeGround_Color );
- TextBackGround( Ansi_BackGround_Color );
-
- CASE C OF
- (* Clear from cursor position to *)
- (* end of screen *)
- 0: BEGIN
-
- X := WhereX;
- Y := WhereY;
-
- ClrEol;
-
- FOR I := ( Y + 1 ) TO 25 DO
- BEGIN
- GoToXY( 1 , I );
- ClrEol;
- END;
-
- GoToXY( X , Y );
-
- END;
- (* Clear start of screen to current *)
- (* cursor position *)
- 1: BEGIN
-
- X := WhereX;
- Y := WhereY;
-
- FOR I := 1 TO ( Y - 1 ) DO
- DelLine;
-
- FOR I := 1 TO X DO
- WRITE(' ');
-
- END;
- (* Clear entire screen *)
- 2: ClrScr;
-
- END (* CASE *);
-
- TextColor ( Save_FG1 );
- TextBackGround( Save_BG1 );
-
- END (* Ansi_Clear_Screen *);
-
- (*----------------------------------------------------------------------*)
- (* Ansi_Clear_Line --- Clear part of line in display *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Ansi_Clear_Line;
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Ansi_Clear_Line *)
- (* *)
- (* Purpose: Clears portion of current line *)
- (* *)
- (* Calling Sequence: *)
- (* *)
- (* Ansi_Clear_Line; *)
- (* *)
- (* Called by: VT100_Process_Escape *)
- (* Ansi_Process_Escape *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- I: INTEGER;
- X: INTEGER;
- Y: INTEGER;
- C: INTEGER;
- Save_FG1: INTEGER;
- Save_BG1: INTEGER;
-
- BEGIN (* Ansi_Clear_Line *)
-
- IF ( Escape_Number = 1 ) THEN
- C := Escape_Register[1]
- ELSE
- C := 0;
-
- Save_FG1 := FG;
- Save_BG1 := BG;
-
- TextColor ( Ansi_ForeGround_Color );
- TextBackGround( Ansi_BackGround_Color );
-
- CASE C OF
-
- (* Clear cursor to end *)
- 0: ClrEol;
- (* Clear start to cursor *)
- 1: BEGIN
- X := WhereX;
- Y := WhereY;
- GoToXY( 1 , Y );
- FOR I := 1 TO X DO
- WRITE(' ');
- END;
- (* Clear entire line *)
- 2: BEGIN
- Y := WhereY;
- GoToXY( 1 , Y );
- ClrEol;
- END;
-
- END (* CASE *);
-
- TextColor ( Save_FG1 );
- TextBackGround( Save_BG1 );
-
- END (* Ansi_Clear_Line *);
-
- (*----------------------------------------------------------------------*)
- (* Ansi_Write_Escape --- Write out escape sequence to display *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Ansi_Write_Escape;
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Ansi_Write_Escape *)
- (* *)
- (* Purpose: Writes unused escape sequence chars to display *)
- (* *)
- (* Calling Sequence: *)
- (* *)
- (* Ansi_Write_Escape; *)
- (* *)
- (* Called by: VT100_Process_Escape *)
- (* Ansi_Process_Escape *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- I: INTEGER;
-
- BEGIN (* Ansi_Write_Escape *)
-
- FOR I := 1 TO LENGTH( Escape_Str ) DO
- Display_Character( Escape_Str[I] );
-
- Escape_Type := ' ';
-
- END (* Ansi_Write_Escape *);
-
- (*----------------------------------------------------------------------*)
- (* Ansi_Next_Char --- Get next character in escape sequence *)
- (*----------------------------------------------------------------------*)
-
- FUNCTION Ansi_Next_Char : CHAR;
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Function: Ansi_Next_Char *)
- (* *)
- (* Purpose: Waits for next character in escape sequence *)
- (* *)
- (* Calling Sequence: *)
- (* *)
- (* Ansi_Next_Char; *)
- (* *)
- (* Called by: VT100_Process_Escape *)
- (* Ansi_Process_Escape *)
- (* *)
- (* Remarks: *)
- (* *)
- (* This routine actually shouldn't be used, but I got lazy. *)
- (* Needs to be fixed next time around. *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- Next_Ch: INTEGER;
-
- BEGIN (* Ansi_Next_Char *)
-
- Async_Receive_With_Timeout( 1 , Next_Ch );
-
- IF Next_Ch > 0 THEN
- Ansi_Next_Char := CHR( Next_Ch )
- ELSE
- Ansi_Next_Char := CHR( 0 );
-
- END (* Ansi_Next_Char *);
-
- (*----------------------------------------------------------------------*)
- (* Ansi_Set_Scrolling_Region --- Set scrolling region (window) *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Ansi_Set_Scrolling_Region;
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Ansi_Set_Scrolling_Region *)
- (* *)
- (* Purpose: Sets scrolling region (window) *)
- (* *)
- (* Calling Sequence: *)
- (* *)
- (* Ansi_Set_Scrolling_Region; *)
- (* *)
- (* Called by: VT100_Process_Escape *)
- (* Ansi_Process_Escape *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- Top: INTEGER;
- Bottom: INTEGER;
-
- BEGIN (* Ansi_Set_Scrolling_Region *)
-
- CASE Escape_Number OF
- (* Window is entire screen *)
- 0: BEGIN
- Top := 1;
- Bottom := 25;
- END;
- (* From specified line to end of screen *)
- 1: BEGIN
- Top := MAX( Escape_Register[1] , 1 );
- Bottom := 25;
- END;
- (* Both top and bottom specified *)
- 2: BEGIN
- Top := MAX( Escape_Register[1] , 1 );
- Bottom := MIN( Escape_Register[2] , 25 );
- END;
-
- ELSE
- Top := MAX( Escape_Register[1] , 1 );
- Bottom := MIN( Escape_Register[2] , 25 );
-
- END (* CASE *);
-
- IF Bottom < Top THEN Bottom := 25;
-
- GoToXY( 1 , 1 );
-
- Top_Scroll := Top;
- Bottom_Scroll := Bottom;
-
- END (* Ansi_Set_Scrolling_Region *);
-
- (*----------------------------------------------------------------------*)
- (* Ansi_Cursor_Up --- Move cursor up *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Ansi_Cursor_Up;
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Ansi_Cursor_Up; *)
- (* *)
- (* Purpose: Moves cursor up specified number of lines *)
- (* *)
- (* Calling Sequence: *)
- (* *)
- (* Ansi_Cursor_Up; *)
- (* *)
- (* Called by: VT100_Process_Escape *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- BEGIN (* Ansi_Cursor_Up *)
-
- IF Escape_Number = 0 THEN
- Reg_Val := 1
- ELSE
- Reg_Val := MAX( 1 , Escape_Register[1] );
-
- GoToXY( Wherex, MAX( WhereY - Reg_Val , 1 ) );
-
- END (* Ansi_Cursor_Up *);
-
- (*----------------------------------------------------------------------*)
- (* Ansi_Cursor_Down --- Move cursor down *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Ansi_Cursor_Down;
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Ansi_Cursor_Down; *)
- (* *)
- (* Purpose: Moves cursor down specified number of lines *)
- (* *)
- (* Calling Sequence: *)
- (* *)
- (* Ansi_Cursor_Down; *)
- (* *)
- (* Called by: VT100_Process_Escape *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- BEGIN (* Ansi_Cursor_Down *)
-
- IF Escape_Number = 0 THEN
- Reg_Val := 1
- ELSE
- Reg_Val := MAX( 1 , Escape_Register[1] );
-
- GoToXY( Wherex, MIN( WhereY + Reg_Val , 25 ) );
-
- END (* Ansi_Cursor_Down *);
-
- (*----------------------------------------------------------------------*)
- (* Ansi_Cursor_Left --- Move cursor left *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Ansi_Cursor_Left;
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Ansi_Cursor_Left; *)
- (* *)
- (* Purpose: Moves cursor left specified number of columns *)
- (* *)
- (* Calling Sequence: *)
- (* *)
- (* Ansi_Cursor_Left; *)
- (* *)
- (* Called by: VT100_Process_Escape *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- BEGIN (* Ansi_Cursor_Left *)
-
- IF Escape_Number = 0 THEN
- Reg_Val := 1
- ELSE
- Reg_Val := MAX( 1 , Escape_Register[1] );
-
- GoToXY( MAX( Wherex - Reg_Val , 1 ), WhereY );
-
- END (* Ansi_Cursor_Left *);
-
- (*----------------------------------------------------------------------*)
- (* Ansi_Cursor_Right --- Move cursor right *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Ansi_Cursor_Right;
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Ansi_Cursor_Right; *)
- (* *)
- (* Purpose: Moves cursor right specified number of columns *)
- (* *)
- (* Calling Sequence: *)
- (* *)
- (* Ansi_Cursor_Right; *)
- (* *)
- (* Called by: VT100_Process_Escape *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- BEGIN (* Ansi_Cursor_Right *)
-
- IF Escape_Number = 0 THEN
- Reg_Val := 1
- ELSE
- Reg_Val := MAX( 1 , Escape_Register[1] );
-
- GoToXY( MIN( WhereX + Reg_Val , 80 ), WhereY );
-
- END (* Ansi_Cursor_Right *);
-
- (*----------------------------------------------------------------------*)
- (* Ansi_Status_Report --- Provide terminal status *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Ansi_Status_Report;
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Ansi_Status_Report; *)
- (* *)
- (* Purpose: Provides status reports to host enquiries *)
- (* *)
- (* Calling Sequence: *)
- (* *)
- (* Ansi_Status_Report; *)
- (* *)
- (* Called by: VT100_Process_Escape *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- Istatus : INTEGER;
- C_Column : STRING[10];
- C_Row : STRING[10];
-
- BEGIN (* Ansi_Status_Report *)
-
- IF Escape_Number = 0 THEN
- Istatus := 5
- ELSE
- Istatus := Escape_Register[ 1 ];
-
- CASE Istatus OF
-
- 5: Async_Send_String( CHR( 27 ) + '[0n' );
-
- 6: BEGIN
- STR( WhereX:3, C_Column );
- STR( WhereY:2, C_Row );
- Async_Send_String( CHR( 27 ) + '[' +
- C_Row + ';' + C_Column + 'R' );
- END;
-
- ELSE;
-
- END (* CASE *);
-
- END (* Ansi_Status_Report *);
-
- (*----------------------------------------------------------------------*)
- (* Ansi_Set_Mode --- Set a terminal mode *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Ansi_Set_Mode;
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Ansi_Set_Mode; *)
- (* *)
- (* Purpose: Set a terminal mode *)
- (* *)
- (* Calling Sequence: *)
- (* *)
- (* Ansi_Set_Mode; *)
- (* *)
- (* Called by: VT100_Process_Escape *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- I: INTEGER;
-
- BEGIN (* Ansi_Set_Mode *)
-
- FOR I := 1 TO Escape_Number DO
-
- CASE Escape_Register[I] OF
-
- 6: Origin_Mode := ON;
-
- 7: Auto_Wrap_Mode := ON;
-
- 12: Local_Echo := ON;
-
- ELSE;
-
- END (* CASE *);
-
- END (* Ansi_Set_Mode *);
-
- (*----------------------------------------------------------------------*)
- (* Ansi_Reset_Mode --- Set a terminal mode *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Ansi_Reset_Mode;
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Ansi_Reset_Mode; *)
- (* *)
- (* Purpose: Resets a terminal mode *)
- (* *)
- (* Calling Sequence: *)
- (* *)
- (* Ansi_Reset_Mode; *)
- (* *)
- (* Called by: VT100_Process_Escape *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- I: INTEGER;
-
- BEGIN (* Ansi_Reset_Mode *)
-
- FOR I := 1 TO Escape_Number DO
-
- CASE Escape_Register[I] OF
-
- 6: Origin_Mode := OFF;
-
- 7: Auto_Wrap_Mode := OFF;
-
- 12: Local_Echo := OFF;
-
- ELSE;
-
- END (* CASE *);
-
- END (* Ansi_Reset_Mode *);
-
- (*----------------------------------------------------------------------*)
- (* Ansi_Printer_Control --- Sets printer control modes *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Ansi_Printer_Control;
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Ansi_Printer_Control; *)
- (* *)
- (* Purpose: Sets printer control modes *)
- (* *)
- (* Calling Sequence: *)
- (* *)
- (* Ansi_Printer_Control; *)
- (* *)
- (* Called by: VT100_Process_Escape *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- I: INTEGER;
-
- BEGIN (* Ansi_Printer_Control *)
-
- IF Escape_Number > 0 THEN
-
- CASE Escape_Register[1] OF
- 4: Auto_Print_Mode := OFF;
- 5: Auto_Print_Mode := ON;
- END (* CASE *);
-
- END (* Ansi_Printer_Control *);
-
- (*----------------------------------------------------------------------*)
- (* Ansi_Process_Escape --- Process ANSI escape sequence *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Ansi_Process_Escape( Ch : CHAR );
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Ansi_Process_Escape *)
- (* *)
- (* Purpose: Processes escape sequence for BBS/ANSI emulation *)
- (* *)
- (* Calling Sequence: *)
- (* *)
- (* Ansi_Process_Escape( Ch: CHAR ); *)
- (* *)
- (* Ch --- Next character in escape sequence *)
- (* *)
- (* Called by: Emulate_Ansi *)
- (* *)
- (* Remarks: *)
- (* *)
- (* This version doesn't process private DEC escape sequences, *)
- (* but DOES play music. *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- Reg_Val : INTEGER;
- Save_X : INTEGER;
- Save_Y : INTEGER;
- More_Escape : BOOLEAN;
-
- BEGIN (* Ansi_Process_Escape *)
-
- More_Escape := FALSE;
-
- CASE Ch OF
-
- ' ' : EXIT;
- ^M : EXIT;
- ^J : EXIT;
-
- '[' : BEGIN
- Escape_Type := '[';
- EXIT;
- END;
-
- 'f' : Ansi_Set_Cursor;
-
- 'H' : Ansi_Set_Cursor;
-
- 'J' : Ansi_Clear_Screen;
-
- 'K' : Ansi_Clear_Line;
-
- 'm' : Ansi_Set_Graphics;
-
- ^N : IF ( Play_Music_On ) THEN
- PibPlay( Escape_Str );
-
- ELSE More_Escape := TRUE;
-
- END (* CASE *);
-
- IF ( NOT More_Escape ) THEN
- Escape_Mode := FALSE
- ELSE
- BEGIN
-
- Ch := UpCase( Ch );
- Escape_Str := Escape_Str + Ch;
-
- IF Ch IN [ 'A'..'G','L'..'P' ] THEN EXIT;
-
- IF Ch IN [ '0'..'9' ] THEN
- BEGIN
- Escape_Register[Escape_Number] :=
- ( Escape_Register[Escape_Number] * 10 ) + ORD( Ch ) -
- ORD( '0' );
- EXIT;
- END;
-
- CASE Ch OF
-
- ';', ',' : BEGIN
- Escape_Number := Escape_Number + 1;
- Escape_Register[Escape_Number] := 0;
- END;
-
- 'T', 'S', '#', '+', '-', '>', '<', '.'
- : ;
- ELSE
- Escape_Mode := FALSE;
- Ansi_Write_Escape;
-
- END (* CASE *);
-
- END (* NOT More_Escape *);
-
- END (* Ansi_Process_Escape *);
-
- (*----------------------------------------------------------------------*)
- (* VT100_Process_Escape --- Process VT100 escape sequence *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE VT100_Process_Escape( Ch : CHAR );
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: VT100_Process_Escape *)
- (* *)
- (* Purpose: Processes escape sequence for DEC VT100 emulation *)
- (* *)
- (* Calling Sequence: *)
- (* *)
- (* VT100_Process_Escape( Ch: CHAR ); *)
- (* *)
- (* Ch --- Next character in escape sequence *)
- (* *)
- (* Called by: Emulate_Ansi *)
- (* *)
- (* Remarks: *)
- (* *)
- (* This version processes private DEC escape sequences. *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- Reg_Val : INTEGER;
- Save_X : INTEGER;
- Save_Y : INTEGER;
- More_Escape : BOOLEAN;
-
- BEGIN (* VT100_Process_Escape *)
-
- More_Escape := FALSE;
-
- CASE Ch OF
-
- ' ' : EXIT;
-
- '#' : IF Escape_Type = ' ' THEN
- BEGIN
- Escape_Type := '#';
- EXIT;
- END
- ELSE
- More_Escape := TRUE;
-
- '[' : BEGIN
- Escape_Type := '[';
- EXIT;
- END;
-
- 'f' : Ansi_Set_Cursor;
-
- 'H' : Ansi_Set_Cursor;
-
- 'J' : Ansi_Clear_Screen;
-
- 'K' : Ansi_Clear_Line;
-
- 'g' : ClrScr;
-
- 'h' : Ansi_Set_Mode;
-
- 'i' : Ansi_Printer_Control;
-
- 'l' : Ansi_Reset_Mode;
-
- 'm' : Ansi_Set_Graphics;
-
- 'r' : IF ( Escape_Type = '[' ) THEN
- Ansi_Set_Scrolling_Region;
-
- 'c' : Async_Send_String( CHR( 27 ) + '[?1;0c' );
-
- 'Z' : IF ( Escape_Type = ' ' ) THEN
- Async_Send_String( CHR( 27 ) + '[?1;0c' );
-
- 'n' : Ansi_Status_Report;
-
- '=' : IF ( Escape_Type = ' ' ) THEN
- VT100_Keypad := ON;
-
- '<' : IF ( Escape_Type <> '[' ) THEN
- BEGIN
- Escape_Mode := FALSE;
- EXIT;
- END;
-
- '>' : IF ( Escape_Type = ' ' ) THEN
- VT100_Keypad := OFF;
-
- 'A' : CASE Escape_Type OF
- ' ': More_Escape := TRUE;
- '[': Ansi_Cursor_Up;
- ELSE;
- END (* CASE *);
-
- 'B' : CASE Escape_Type OF
- ' ': More_Escape := TRUE;
- '[': Ansi_Cursor_Down;
- ELSE;
- END (* CASE *);
-
- 'C' : CASE Escape_Type OF
- ' ': More_Escape := TRUE;
- '[': Ansi_Cursor_Right;
- ELSE;
- END (* CASE *);
-
- 'D' : CASE Escape_Type OF
-
- ' ': BEGIN
- IF WhereY < 25 THEN
- GoToXY( WhereX , WhereY + 1 )
- ELSE
- BEGIN
- Save_X := WhereX;
- Save_Y := WhereY;
- InsLine;
- GoToXY( Save_X, Save_Y );
- END;
- END;
-
- '[': Ansi_Cursor_Left;
-
- ELSE;
-
- END (* CASE *);
-
- '3' : IF Escape_Type <> '#' THEN More_Escape := TRUE;
-
- '4' : IF Escape_Type <> '#' THEN More_Escape := TRUE;
-
- '5' : IF Escape_Type = '#' THEN
- Double_Width_Mode := OFF
- ELSE
- More_Escape := TRUE;
-
- '6' : IF Escape_Type = '#' THEN
- Double_Width_Mode := ON
- ELSE
- More_Escape := TRUE;
-
- '7' : CASE Escape_Type OF
-
- ' ': BEGIN
- Save_Row_Position := WhereX;
- Save_Col_Position := WhereY;
- Save_FG_Color := FG;
- Save_BG_Color := BG;
- END;
- ELSE More_Escape := TRUE;
-
- END (* CASE *);
-
- '8' : CASE Escape_Type OF
-
- ' ': BEGIN
- GoToXY( Save_Row_Position , Save_Col_Position );
- FG := Save_FG_Color;
- BG := Save_BG_Color;
- TextColor( FG );
- TextBackGround( BG );
- END;
-
- ELSE More_Escape := TRUE;
-
- END (* CASE *);
-
- ')' : IF ( Escape_Type <> '[' ) THEN
- BEGIN
- VT100_Graphics_Mode := FALSE;
- Ch := Ansi_Next_Char;
- END;
-
- '(' : IF ( Escape_Type <> '[' ) THEN
- BEGIN
- Escape_Type := '(';
- Ch := Ansi_Next_Char;
- VT100_Graphics_Mode := ( Ch = '0' ) AND VT100_Allowed;
- END;
-
- 'E' : IF ( Escape_Type <> '[' ) THEN
- IF ( WhereY >= Top_Scroll ) AND
- ( WhereY <= Bottom_Scroll ) THEN
- BEGIN
- Window( 1, Top_Scroll, 80, Bottom_Scroll );
- WRITELN;
- Window( 1, 1, 80, 25 );
- END
- ELSE
- WRITELN;
-
- 'M' : IF ( Escape_Type <> '[' ) THEN
- BEGIN
- IF WhereY > Top_Scroll THEN
- GoToXY( WhereX , WhereY - 1 )
- ELSE
- BEGIN
- Save_X := WhereX;
- Save_Y := WhereY;
- Window( 1, Top_Scroll, 80, Bottom_Scroll );
- InsLine;
- Window( 1, 1, 80, 25 );
- GoToXY( Save_X, Save_Y );
- END;
- END;
-
- ELSE More_Escape := TRUE;
-
- END (* CASE *);
-
- IF ( NOT More_Escape ) THEN
- Escape_Mode := FALSE
- ELSE
- BEGIN
-
- Ch := UpCase( Ch );
- Escape_Str := Escape_Str + Ch;
-
- IF Ch IN [ 'A'..'G','L'..'P' ] THEN EXIT;
-
- IF Ch IN [ '0'..'9' ] THEN
- BEGIN
- Escape_Register[Escape_Number] :=
- ( Escape_Register[Escape_Number] * 10 ) + ORD( Ch ) -
- ORD( '0' );
- EXIT;
- END;
-
- CASE Ch OF
-
- ';', ',' : BEGIN
- Escape_Number := Escape_Number + 1;
- Escape_Register[Escape_Number] := 0;
- END;
-
- 'T', 'S', '#', '+', '-', '>', '<', '.','?','='
- : ;
- ELSE
- Escape_Mode := FALSE;
- Ansi_Write_Escape;
-
- END (* Case *);
-
- END (* NOT More_Escape *);
-
- END (* VT100_Process_Escape *);
-
- (*----------------------------------------------------------------------*)
- (* Ansi_Set_Input_Keys --- Set input key mapping for ANSI mode *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Ansi_Set_Input_Keys;
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Ansi_Set_Input_Keys *)
- (* *)
- (* Purpose: Provides conversion string from PC keys to VT100 *)
- (* *)
- (* Calling Sequence: *)
- (* *)
- (* Ansi_Set_Input_Keys; *)
- (* *)
- (* Calls: *)
- (* *)
- (* None *)
- (* *)
- (* Called by: Emulate_Ansi *)
- (* *)
- (* Remarks: *)
- (* *)
- (* This routine defines the strings to be sent to the host when *)
- (* a keyboard key is depressed. *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- CONST
- Esc_Char = ^[;
-
- VAR
- I: INTEGER;
- J: INTEGER;
-
- BEGIN (* Ansi_Set_Input_Keys *)
- (* Make sure the arrows at least are set *)
-
- J := Keypad_Key_Index[U_Arrow];
- I := ( J - 1 ) DIV 10 + 1;
- J := J - ( I - 1 ) * 10;
-
- IF Keypad_Keys[I,J] = '' THEN
- Keypad_Keys[I,J] := Esc_Char + '[A';
-
- J := Keypad_Key_Index[D_Arrow];
- I := ( J - 1 ) DIV 10 + 1;
- J := J - ( I - 1 ) * 10;
-
- IF Keypad_Keys[I,J] = '' THEN
- Keypad_Keys[I,J] := Esc_Char + '[B';
-
- J := Keypad_Key_Index[L_Arrow];
- I := ( J - 1 ) DIV 10 + 1;
- J := J - ( I - 1 ) * 10;
-
- IF Keypad_Keys[I,J] = '' THEN
- Keypad_Keys[I,J] := Esc_Char + '[D';
-
- J := Keypad_Key_Index[R_Arrow];
- I := ( J - 1 ) DIV 10 + 1;
- J := J - ( I - 1 ) * 10;
-
- IF Keypad_Keys[I,J] = '' THEN
- Keypad_Keys[I,J] := Esc_Char + '[C';
-
- END (* Ansi_Set_Input_Keys *);
-
- (*----------------------------------------------------------------------*)
-
- BEGIN (* Emulate_ANSI *)
- (* Indicate ANSI/VT100 being simulated *)
- Save_Screen( Saved_Screen );
- Draw_Menu_Frame( 10, 10, 55, 15, Menu_Frame_Color,
- Menu_Text_Color, '' );
-
- IF VT100_Allowed THEN
- WRITELN('Emulating VT100 Terminal')
- ELSE
- WRITELN('Emulating BBS/ANSI Terminal');
-
- DELAY( One_Second_Delay );
-
- Restore_Screen( Saved_Screen );
- Reset_Global_Colors;
-
- (* Initialize terminal state *)
- Done := FALSE;
- VT100_Keypad := OFF;
- VT100_Graphics_Mode := OFF;
- Auto_Print_Mode := OFF;
- Origin_Mode := OFF;
- Auto_Wrap_Mode := ON;
- Printer_Ctrl_Mode := OFF;
- Escape_Mode := FALSE;
- Escape_Str := '';
- NewX := WhereX;
- NewY := WhereY;
-
- (* Initial scrolling region is *)
- (* entire screen. *)
- Top_Scroll := 1;
- Bottom_Scroll := 24;
- (* Background, foreground *)
-
- Save_Global_FG := Global_ForeGround_Color;
- Save_Global_BG := Global_BackGround_Color;
- Save_FG := ForeGround_Color;
- Save_BG := BackGround_Color;
-
- (* Set colors. *)
- IF( NOT VT100_Allowed ) THEN
- BEGIN
-
- White_Shade := LIGHTGRAY;
- Ansi_ForeGround_Color := LIGHTGRAY;
- Ansi_BackGround_Color := BLACK;
- Ansi_Underline_Color := BLUE;
- Ansi_Bold_Color := WHITE;
-
- ForeGround_Color := LIGHTGRAY;
- BackGround_Color := BLACK;
-
- FG := LIGHTGRAY;
- BG := BLACK;
-
- END
- ELSE
- BEGIN
-
- White_Shade := VT100_ForeGround_Color;
- Ansi_ForeGround_Color := VT100_ForeGround_Color;
- Ansi_BackGround_Color := VT100_BackGround_Color;
- Ansi_Underline_Color := VT100_Underline_Color;
- Ansi_Bold_Color := VT100_Bold_Color;
-
- ForeGround_Color := VT100_ForeGround_Color;
- BackGround_Color := VT100_BackGround_Color;
-
- FG := VT100_ForeGround_Color;
- BG := VT100_BackGround_Color;
-
- END;
-
- Set_Global_Colors( Ansi_ForeGround_Color , Ansi_BackGround_Color );
-
- (* Initialize music playing *)
- PibPlaySet;
- (* Set up input key mapping *)
- Ansi_Set_Input_Keys;
- (* Loop over input until done *)
- WHILE ( NOT Done ) DO
- BEGIN
-
- IF KeyPressed THEN
- BEGIN (* KeyPressed *)
-
- READ( Kbd , Comm_Ch );
-
- CASE ORD( Comm_Ch ) OF
-
- ESC: IF KeyPressed THEN
- BEGIN
- Process_Command( Comm_Ch, FALSE, PibTerm_Command );
- IF PibTerm_Command <> Null_Command THEN
- Execute_Command( PibTerm_Command, Done, FALSE );
- END
- ELSE
- BEGIN
- IF Local_Echo THEN WRITE( Comm_Ch );
- Async_Send( Comm_Ch );
- END;
-
- BS: BEGIN
- Comm_Ch := BS_Char;
- IF Local_Echo THEN WRITE( Comm_Ch );
- Async_Send( Comm_Ch );
- END;
-
- DEL: BEGIN
- Comm_Ch := Ctrl_BS_Char;
- IF Local_Echo THEN WRITE( Comm_Ch );
- Async_Send( Comm_Ch );
- END;
-
- ELSE
- BEGIN
- IF Local_Echo THEN WRITE( Comm_Ch );
- Async_Send( Comm_Ch );
- END;
-
- END (* CASE ORD( Comm_Ch ) *);
-
- END (* KeyPressed *);
-
- IF ( Script_File_Mode AND ( NOT ( Done OR Really_Wait_String ) ) ) THEN
- BEGIN
- Get_Script_Command( PibTerm_Command );
- Execute_Command ( PibTerm_Command , Done , TRUE );
- END;
-
- IF Async_Receive( Comm_Ch ) THEN
-
- BEGIN (* Comm_Ch found *)
-
- Async_Buffer_Full;
-
- Comm_Ch := TrTab[ Comm_Ch ];
-
- IF Comm_Ch = CHR( ESC ) THEN
- BEGIN (* ESC found *)
-
- IF Escape_Mode THEN Ansi_Write_Escape;
-
- Escape_Str := '';
- Escape_Number := 1;
- Escape_Register[1] := 0;
- Escape_Mode := TRUE;
- Escape_Type := ' ';
-
- END
-
- ELSE IF Escape_Mode THEN
-
- CASE VT100_Allowed OF
- TRUE: VT100_Process_Escape( Comm_Ch );
- FALSE: Ansi_Process_Escape( Comm_Ch );
- END (* CASE *)
-
- ELSE
-
- CASE ORD( Comm_Ch ) OF
-
- LF,
- FF,
- VT: BEGIN (* go down one line *)
-
- IF ( WhereY = Bottom_Scroll ) THEN
- BEGIN
- Window( 1, Top_Scroll, 80, Bottom_Scroll );
- Display_Character( CHR( LF ) );
- Window( 1, 1, 80, 25 );
- END
- ELSE
- Display_Character( CHR( LF ) );
-
- IF Auto_Print_Mode THEN
- BEGIN
- Get_Screen_Text_Line( Print_Line, WhereY - 1,
- 1 );
- WRITELN( Lst , Print_Line );
- END;
-
- END (* go down one line *);
-
- HT: BEGIN (* Convert tabs to sequence of blanks *)
- (*
- Curcol := WhereX;
- Itab := 1;
- WHILE( Curcol > VT100_Tabs[Itab] ) DO
- Itab := Itab + 1;
- Tabcol := VT100_Tabs[Itab];
- FOR Itab := Curcol To ( Tabcol - 1 ) DO
- WRITE(' ');
- *)
- Display_Character( Comm_Ch );
- END (* Tabs *);
-
- SO: IF VT100_Allowed THEN
- VT100_Graphics_Mode := ON;
-
- SI: IF VT100_Allowed THEN
- VT100_Graphics_Mode := OFF;
-
- (* CompuServe B protocol request *)
-
- ENQ: IF CompuServe_B_On THEN
- B := Do_CompuServe_B_Transfer
- ELSE
- Display_Character( Comm_Ch );
-
- ELSE
- IF NOT VT100_Graphics_Mode THEN
- Display_Character( Comm_Ch )
- ELSE
- BEGIN (* Graphics Mode *)
- IF ORD( Comm_Ch ) IN [ 95 .. 126 ] THEN
- BEGIN
- Graph_Ch := Graphics_Chars[ ORD( Comm_Ch ) ];
- Display_Character( CHR( Graph_Ch ) );
- END
- ELSE
- Display_Character( Comm_Ch );
- END (* Graphics Mode *);
-
- END (* CASE ORD( Comm_Ch ) *);
-
- END (* Comm_Ch found *);
-
- END (* NOT Done *);
- (* Restore colors *)
-
- ForeGround_Color := Save_FG;
- BackGround_Color := Save_BG;
-
- Set_Global_Colors( ForeGround_Color , BackGround_Color );
-
- END (* Emulate_ANSI *);